home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PROGEDIT / 1023.ZIP / DIRLST.PAS < prev    next >
Pascal/Delphi Source File  |  1986-02-22  |  4KB  |  153 lines
  1.  
  2. procedure ListDir;
  3. type
  4.   CharArray15 = array [1..55] of Char;
  5.   registers   =  record
  6.       AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
  7.   end;
  8. var
  9.   Regs            : Registers;
  10.   DTA             : array [1..43] of Byte;
  11.   Mask            : CharArray15;
  12.   Fname,maskstr   : String[55];
  13.   RtnCode,I,count : Integer;
  14.   driveltr,junk   : char;
  15.  
  16. function ValidDrive(var dr : char): boolean;
  17. begin
  18.   dr := Upcase(dr);
  19.   if not (dr in ['L','M','*','?']) then
  20.   begin
  21.     regs.ax := $3600;
  22.     regs.dx := (ord(dr)+1) - ord('A');
  23.     intr($21,regs);
  24.     if (regs.ax = $ffff) then
  25.     begin
  26.       ValidDrive := false;
  27.       writeln;
  28.       write(' Drive: '^G,dr,':, Invalid');clreol;
  29.       delay(1500);
  30.     end
  31.     else ValidDrive := true;
  32.   end else ValidDrive := true;
  33. end;
  34.  
  35.  
  36. procedure GetStatus(ch : char);
  37. var
  38.   Tracks,TotalTracks,Drive,Bytes,
  39.   Sectors         : Integer;
  40.   Used,TotalBytes : Real;
  41.  
  42. begin
  43.   ch := upcase(Ch);
  44.   if not(ch in ['L','*','?']) then drive := (ord(ch)+1) - ord('A') else drive := 0;
  45.   Regs.AX := $3600;
  46.   Regs.DX := Drive;
  47.   MSDos(Regs);
  48.   Tracks := Regs.BX;
  49.   TotalTracks := Regs.DX;
  50.   Bytes := Regs.CX;
  51.   Sectors := Regs.AX;
  52.   writeln; clreol;
  53.   Write( '       ' ); clreol;
  54.   if not(ch in ['L','*','?']) then
  55.   WriteLn('  Status of Drive ', chr(Drive + $40), ':')
  56.   else writeln('  Status of Logged Drive: ');
  57.   clreol;
  58.   Used :=  ((TotalTracks - Tracks) / TotalTracks) * 100;
  59.   Write('     ',Used:7:0, '% used.' ); clreol;
  60.   TotalBytes := ((Sectors * Bytes * 1.0) * Tracks);
  61.   WriteLn(' With ',TotalBytes:7:0,' Total Bytes Free.');clreol;
  62. end;
  63.  
  64. procedure ConstrName(nax : integer);
  65. begin
  66.   with regs do
  67.   begin
  68.     AX := nax;
  69.     DS := Seg(Mask);
  70.     DX := Ofs(Mask);
  71.     CX := 22;
  72.     MSDos(Regs);
  73.     RtnCode := AX and $FF;
  74.   end;
  75.   i := 1;
  76.   if (RtnCode = 0) then
  77.   repeat
  78.     Fname[i] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+i]);
  79.     i := i + 1;
  80.   until not (Fname[i-1] in [' '..'~']) or (i>15);
  81. end;
  82.  
  83. procedure GetMask;
  84. begin
  85.   repeat
  86.    gotoxy(1,24);
  87.     write('Enter Mask: (ie A:\LETTER\*.TXT) ');clreol;
  88.     readln(maskstr);
  89.     driveltr := upcase(maskstr[1]);
  90.   until validdrive(driveltr);
  91. end;
  92.  
  93. begin
  94.   count := 1;
  95.   RtnCode :=0;
  96.   FillChar(DTA,SizeOf(DTA),0);
  97.   FillChar(Mask,SizeOf(Mask),0);
  98.   FillChar(Fname,SizeOf(Fname),0);
  99.   with regs do
  100.   begin
  101.     AX := $1A00;
  102.     DS := Seg(DTA);
  103.     DX := Ofs(DTA);
  104.   end;
  105.   MSDos(Regs);
  106.   repeat
  107.     gotoxy(1,24);
  108.     write('List Directory:  L(ogged directory,  M(ask  or drive (ie ''A'') ');clreol;
  109.     repeat
  110.       read(kbd,driveltr);
  111.       driveltr := upcase(driveltr);
  112.     until (driveltr in ['A'..'F','L','M'])
  113.   until (driveltr in ['A'..'F','L','M']) and (validdrive(driveltr));
  114.   if driveltr <> 'L'
  115.     then maskstr := driveltr + ':\????????.???'
  116.        else maskstr :=  '???????????.???';
  117.   if driveltr = 'M' then getmask;
  118.  
  119.   for i := 1 to length(maskstr) do mask[i] :=  maskstr[i];
  120.   gotoxy(1,2);clreol;
  121.   if driveltr in['L','*','?'] then
  122.   writeln('    Directory of Logged Drive')
  123.   else  writeln('    Directory of ',driveltr,': Drive');
  124.   ConstrName($4E00);
  125.   Fname[0] := Chr(i-1);
  126.   write(Fname:18);clreol;
  127.   while (RtnCode = 0) do
  128.   begin
  129.     ConstrName($4F00);
  130.     if count mod 4 = 0 then writeln;clreol;
  131.     if count mod 60 = 0 then
  132.     begin
  133.       writeln;clreol;
  134.       write('More - Press any key');
  135.       read(kbd,junk);
  136.       window(1,1,80,20);
  137.       clrscr;
  138.       gotoxy(1,2);
  139.       if driveltr in['L','*','?'] then
  140.       writeln('    Directory of Logged Drive')
  141.       else  writeln('    Directory of ',driveltr,': Drive');
  142.       writeln;
  143.       window(1,1,80,25);
  144.     end;
  145.     count := count + 1;
  146.     Fname[0] := Chr(I-1);
  147.     if (RtnCode = 0) then Write(Fname:18); clreol;
  148.   end;
  149.   writeln;clreol;
  150.   getstatus(driveltr);
  151. end;
  152.  
  153.